package Flap::Schema::Storage;
use Flap qw/-b Flap::Object -m -r -s -w/;
use constant T_INFLATE => {};

sub DB { ${$_[0]} }

sub config {
    my $self = shift;
    $self->project->config->DB->$$self;
}

sub dbh {
    my $self = shift;
    $self->project->dbh($self->DB);
}

sub dbname {
    my $dsn = shift->master_dsn;
    $dsn->[0] =~ /^dbi:\w+:(\w+)/ && $1 || die qq{Can't parse dsn: "$dsn->[0]"};
}

sub disable_constraint_sql { '' }

sub enable_constraint_sql { '' }

sub host { shift->master_dsn->[0] =~ /host=([^\s;]+)/ && $1 || 'localhost' }

sub insert {
    my($self, $row, $opt) = @_;
    my $txn = $row->{-txn};
    my $org = $row->{-org};
    my(@col, @val, %org);
    foreach(@{$row->columns}){
        (push @col, $_) && next if(
            $txn && exists $txn->{$_} && (push @val, $org{$_} = $txn->{$_})
         || $org && exists $org->{$_} && (push @val, $org{$_} = $org->{$_})
        );
        $org{$_} = undef;
    }
    $self->dbh->prepare_cached(
        'INSERT INTO '.$row->table.' ('.join(', ', @col).
        ') VALUES ('.join(', ', map{ '?' } @val).')'
    )->execute(@val) || die $self->dbh->errstr;
    delete $row->{-txn};
    $row->{-org} = \%org;
    1;
}

sub master_dsn { shift->config->dsn->[0] }

sub mysql { shift->MySQL }

sub new { bless \"$_[1]", $_[0] }

sub on_add_column {
    my($self, $sch, $col, $ci) = @_;
    $ci->{-i} ||= $self->T_INFLATE->{$ci->{-t}};
}

sub parse_join {
    my($self, $join, $ji, $p, $sr, $xr) = @_;
    
    foreach my $as (sort keys %$join){
        die qq{Non-unique join alias "$as"} if $ji->{$as};
        my $opt = $join->{$as} || die qq{No join option for "$as"};
=head
        if(ref $opt eq 'HASH'){
            next;
        }
=cut
        (my $sn, my $on, $opt) = @$opt;
        push @{$p->{fetch} ||= []}, my $j = $ji->{$as} = {as => $as, depth => $p->{depth} + 1};
        $self->_weaken_($j->{parent} = $p);
        my $sch = $j->{schema} = $p->{schema}->_parent_class_->$sn;
        my $t = $sch->table || die "No table for $sch";
        my $m = $sch->_multiplicity_($opt->{-m}, $as);
        $$sr .= "\n".($m->{outer} ? 'LEFT ' : '')."JOIN $t $as ON ".$self->sql_where($on, $xr);
        $j->{multi} = $m->{multi};
    }
}

sub password {
    my $pw = shift->master_dsn->[2];
    defined $pw ? $pw : '';
}

sub rfetch {
    my($self, $ar, $j, $p, $rs) = @_;
    
    my @pk = @$ar[@{$j->{pki}}];
    return if !defined $pk[0]; #outer join
    my $r = $j->{r}{join("\0", @pk)} ||= do{
        my $r = $j->{schema}->instantiate({map{ $_->[0] => $ar->[$_->[1]] } @{$j->{n2i}}});
        if($j->{fetch}){
            $r->_set_related_($_->{as}, $_->{multi} ? [] : undef) for @{$j->{fetch}};
        }
        if(!$p){
            push @$rs, $r;
        }elsif($j->{multi}){
            push @{$p->{-rel}{$j->{as}}}, $p->_add_to_cache_($r);
            #$p->_set_reverse_relations_($r);
        }else{
            $p->{-rel}{$j->{as}} = $p->_add_to_cache_($r);
            #$p->_set_reverse_relations_($r);
        }
        $r;
    };
    return if !$j->{fetch};
    $self->rfetch($ar, $_, $r) for @{$j->{fetch}};
}

=head
my $r = $proj->schema->User->search({
    select => '*',
    select => [qw/foo bar/, ['max(baz)']],
    join => {
        tasks => {events => {}},
        site  => ['Site', ['site.id = me.site_id'], {-m => 1}],
    },
    where => [
        ['me.id = ?', 100],
        ['me.id in (?)', \@id],
        ['me.xday <= ? and ? <= me.xday', $proj->now, $proj->now],
        [
            ['me.id = ?', 100],
            -or => ['me.id = ?', 100],
            -or => ['me.id = ?', 100],
        ],
    ],
    order_by => ['name, age desc, IF(?, 1)', $hoge];
    for => 'update',
});
=cut
sub search {
    my($self, $sch, $opt) = @_;
    my $t = $sch->table || die "No table for $sch";
    my($s, @x, @cx, @ox, %join_info, @join_fetch, $sql);
    my $src = my $ord = '';
    
    my $cols = !($s = $opt->{select}) ? 'me.*' :
        (ref $s eq 'HASH') ? join(', ', map{ $self->sql_cols($s->{$_}, \@cx, $_) } keys %$s) :
        $self->sql_cols($s, \@cx);
    
    my $sp = ' ';
    if($opt->{join} && %{$opt->{join}}){
        my $me = $join_info{me} = {as => 'me', depth => 1, schema => $sch};
        $self->parse_join($opt->{join} => \%join_info, $me, \$src, \@x);
        $cols = $self->search_cols_for_join(\$cols, \%join_info, \@join_fetch);
        $sp = "\n";
    }
    
    $src .= $sp."WHERE $s"    if ($s = $opt->{where})    && ($s = $self->sql_where($s, \@x));
    $src .= $sp."GROUP BY $s" if ($s = $opt->{group_by}) && ($s = $self->sql_cols($s, \@x));
    $src .= $sp."HAVING $s"   if ($s = $opt->{having})   && ($s = $self->sql_where($s, \@x));
    $ord  = $sp."ORDER BY $s" if ($s = $opt->{order_by}) && ($s = $self->sql_cols($s, \@ox));
    
    #if($opt->{for}){
    #    die qq{Invalid option "for => $opt->{for}"} if lc($opt->{for}) ne 'update';
    #    $src .= ' for update';
    #}
    
    if($opt->{rows} && %join_info && grep{ $_->{multi} } values %join_info){
        my $pk = $sch->primary_key || die $sch->_dmsg_(7);
        my $pks = join(', ', map{ "me.$_" } @$pk);
        (my $us = "\nSELECT $pks FROM $t me$src") =~ s/\n/\n  /g;
        $us = "SELECT $pks FROM ($us\n ) me GROUP BY $pks".($ord && ' '.substr($ord, 1));
        $self->sql_limit(\$us, $opt->{rows}, $opt->{page});
        $sql = "SELECT $cols FROM (\n $us\n) us".
            " JOIN $t me ON ".join(' and ', map{ "me.$_ = us.$_" } @$pk).$src.$ord;
        @x = (@cx, @x, @ox, @x, @ox);
    }else{
        $sql = "SELECT $cols${sp}FROM $t me$src$ord";
        @x = (@cx, @x, @ox);
        $self->sql_limit(\$sql, $opt->{rows}, $opt->{page}) if $opt->{rows};
    }
    
    my $sth = $self->dbh->prepare_cached($sql);
    $sth && $sth->execute(@x) || die $self->dbh->errstr;
    my @r;
    if(!%join_info){
        while(my $hr = $sth->fetchrow_hashref){
            push @r, $sch->instantiate($hr);
        }
    }else{
        my $n = $sth->{NAME_lc};
        my $j = $join_info{shift @join_fetch} || die;
        my $i = -1;
        foreach(@$n){
            next if $_ eq '|' && (($j = $join_info{shift @join_fetch}) || die);
            push @{$j->{n2i}}, [$_ => ++$i];
            push @{$j->{pki}}, $i if $j->{pk}{$_};
        }
        while(my $ar = $sth->fetchrow_arrayref){
            $self->rfetch($ar, $join_info{me}, undef, \@r);
        }
    }
    wantarray ? @r : $r[0];
}

sub search_cols_for_join {
    my($self, $cols, $ji, $jf) = @_;
    $cols = $self->split_cols($cols);
    
    my @njc;
    foreach(@$cols){
        /^\s*(\w+)\.(\*|\w+)\s*\z/ || push(@njc, $_) && next;
        my $j = $ji->{$1} || die qq{No join alias "$1" for "$_"};
        $j->{cols}{lc($2)} = 1;
    }
    
    foreach(values %$ji){
        my $j = $_->{cols} ? $_ : next;
        while($j && !$j->{pk}){
            my $pk = $j->{schema}->primary_key || die $j->{schema}->_dmsg_(7);
            $j->{pk}{$_} = $j->{cols}{$_} = 1 for @$pk;
            $j = $j->{parent};
        }
    }
    
    my @cols;
    foreach my $j (
        sort{ $a->{depth} <=> $b->{depth} || $a->{as} cmp $b->{as} }
        grep{ $_->{cols} } values %$ji
    ){
        delete $j->{fetch} if !@{$j->{fetch} = [grep{ $_->{cols} } @{$j->{fetch}}]};
        my $cols = $j->{cols} || next;
        if($cols->{'*'}){
            push @cols, "$j->{as}.*";
        }else{
            $cols->{$_} && push @cols, "$j->{as}.$_" for @{$j->{schema}->columns};
        }
        push(@cols, @njc) && undef @njc if @njc;
        push @cols, "'|'";
        push @$jf, $j->{as};
    }
    pop @cols;
    join(', ', @cols);
}

sub split_cols {
    my($self, $cols) = @_;
    my $pos = my $wrap = 0;
    my @cols;
    while($$cols =~ /([(),])/g){
        if($1 ne ','){
            $wrap += $1 eq '(' ? 1 : -1;
            die 'Parse error near "'.substr($$cols, $pos, pos($$cols) - $pos).'"' if $wrap < 0;
            next;
        }
        next if $wrap;
        push @cols, substr($$cols, $pos, pos($$cols) - 1 - $pos);
        $pos = pos($$cols);
    }
    push @cols, substr($$cols, $pos);
    \@cols;
}

=head
order_by => 'foo, bar',
order_by => ['foo desc', 'bar desc'],
order_by => [['IF(foo, ?, ?)', 1, 1], 'bar'],
=cut
sub sql_cols {
    my($self, $cols, $bind, $me) = @_;
    $me ||= 'me';
    return "$me.*" if $cols eq '*';
    return $cols if !ref $cols;
    
    my @cols;
    foreach(@$cols){
        if(ref $_){
            push @cols, $_->[0];
            push @$bind, @{$_}[1 .. $#$_];
        }else{
            push @cols, /^\s*(\w+(\s+\w+)*)\s*\z/ ? "$me.$1" : $_;
        }
    }
    join(', ', @cols);
}

sub sql_limit {
    my($self, $sr, $rows, $page) = @_;
    my $lim = ' LIMIT ';
    $lim .= ($page * $rows - 1).',' if $page;
    $lim .= $rows;
    $$sr .= $lim;
}

sub sql_where {
    my($self, $w, $bind, $wrap) = @_;
    if(!ref $w->[0]){
        push @$bind, @{$w}[1 .. $#$w];
        return $w->[0];
    }
    ($wrap ? '(' : '').
    join(' and ', map{ $_ eq '-or' ? ' or ' : $self->sql_where($_, $bind, 1) } @$w).
    ($wrap ? ')' : '');
}

sub update {
    my($self, $row, $opt) = @_;
    my @pk = @{$row->primary_key || die $row->_dmsg_(7)};
    my $org = $row->{-org};
    my @id = map{ exists $org->{$_} ? $org->{$_} : die $row->_dmsg_(6, $_) } @pk;
    if($opt->{-l} && $row->column_info(my $lv = $row->LOCK_VERSION)){
        push @pk, $lv;
        push @id, my $i = $row->get_column($lv);
        $row->set_column($lv, ($i + 1) % 128);
    }
    
    my $txn = $row->{-txn};
    $org = undef if !$opt->{-f};
    my(@col, @val);
    foreach(@{$row->columns}){
        push @col, $_ if(
            $txn && exists $txn->{$_} && (push @val, $txn->{$_})
         || $org && exists $org->{$_} && (push @val, $org->{$_})
        );
    }
    die '?' if !@col;
    $self->dbh->prepare_cached(
        'UPDATE '.$row->table.' set '.join(', ', map{ "$_ = ?" } @col).
        ' WHERE '.join(' and ', map{ "$_ = ?" } @pk)
    )->execute(@val, @id) || die $self->dbh->errstr;
    $txn = delete $row->{-txn};
    $row->{-org}{$_} = $txn->{$_} for keys %$txn;
    1;
}

sub user { shift->master_dsn->[1] }

1;
